home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / laminate.src < prev    next >
Text File  |  1991-10-19  |  6KB  |  333 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ LAMINATE by Jay Nestle
  3. DIR
  4.   INT1
  5.     \<<
  6. "No. of new materials?"
  7. "" INPUT OBJ\->
  8.       \<< \-> C
  9.         \<<
  10.           WHILE 0
  11. 'C' DECR \<=
  12.           REPEAT
  13. MATER
  14.           END
  15.         \>>
  16.       \>> EVAL
  17. "Change in temp?"
  18. ":\GDT:" INPUT OBJ\->
  19. OBJ\-> DROP '\GDT' STO
  20. "Number of Layers?"
  21. "" INPUT OBJ\-> 1
  22. SWAP
  23.       FOR X LAYER
  24.       NEXT
  25.     \>>
  26.   CALC
  27.     \<< 'L1' LAYERS
  28. layerlist OBJ\-> SWAP
  29. DUP UPDIR
  30. 'CurrentLayer' STO
  31. SWAP 1 SWAP
  32.       FOR TC DUP
  33. LAYERS EVAL '\Gh' RCL
  34. '\Gh' '\Ga1' RCL '\Ga1'
  35. '\Ga2' RCL '\Ga2' 'Mat'
  36. @ [Note: 'MAT' renamed to 'Mat' to prevent TLLIB conflicts.  -jkh-]
  37. RCL UPDIR UPDIR
  38. MATERIALS EVAL 'E1'
  39. RCL 'E1' 'E2' RCL
  40. 'E2' 'v21' RCL
  41. 'v21' 'v12' RCL
  42. 'v12' 'G12' RCL
  43. 'G12' UPDIR UPDIR
  44. Formulas STO STO
  45. STO STO STO STO STO
  46. STO EQ11 ERPT EQ22
  47. ERPT EQ66 ERPT EQ12
  48. ERPT EQ11B ERPT
  49. EQ12B ERPT EQ22B
  50. ERPT EQ16B ERPT
  51. EQ26B ERPT EQ66B
  52. ERPT E\Gaxy ERPT E\Gax
  53. ERPT E\Gay ERPT \Gax \Gay
  54. \Gaxy { 3 1 } \->ARRY
  55. SWAP Q11B Q12B Q16B
  56. Q12B Q22B Q26B Q16B
  57. Q26B Q66B { 3 3 }
  58. \->ARRY UPDIR
  59. CurrentLayer LAYERS
  60. EVAL SWAP "QB" SWAP
  61. + OBJ\-> STO 'M\Gaxy'
  62. STO UPDIR UPDIR DUP
  63. 'CurrentLayer' STO
  64. LAYERS
  65.       NEXT AMAT
  66. BMAT DMAT ABD2M
  67. DROP
  68.     \>>
  69.   CNT\Ga
  70.     \<< LAYERS
  71. layerlist OBJ\-> 1
  72. SWAP
  73.       FOR X X ROLL
  74. DUP EVAL "QB" SWAP
  75. + OBJ\-> t * \GDT *
  76. M\Gaxy * UPDIR
  77.       NEXT 1
  78. NoLayers 1 -
  79.       FOR X +
  80.       NEXT 2 * DUP
  81. \GDT / ABDM A INV
  82. SWAP * 2 / '\GaLAM'
  83. STO 'NT' STO
  84.     \>>
  85.   MATERIALS
  86.     DIR
  87.       materiallist
  88. { }
  89.     END
  90.   LAYERS
  91.     DIR
  92.       ABDM
  93.         DIR
  94.         END
  95.       NoLayers 0
  96.       layerlist { }
  97.     END
  98.   Formulas
  99.     DIR
  100.       E\Gaxy '\Gaxy=2*(
  101. \Ga1-\Ga2)*COS(\Gh)*SIN(\Gh
  102. )'
  103.       E\Gay '\Gay=\Ga2*
  104. COS(\Gh)^2+\Ga1*SIN(\Gh)^
  105. 2'
  106.       E\Gax '\Gax=\Ga1*
  107. COS(\Gh)^2+\Ga2*SIN(\Gh)^
  108. 2'
  109.       EQ66B 'Q66B=(
  110. Q11+Q22-2*Q12-2*Q66
  111. )*SIN(\Gh)^2*COS(\Gh)^2
  112. +Q66*(SIN(\Gh)^4+COS(
  113. \Gh)^4)'
  114.       EQ26B 'Q26B=(
  115. Q11-Q12-2*Q66)*SIN(
  116. \Gh)^3*COS(\Gh)+(Q12-
  117. Q22+2*Q66)*SIN(\Gh)*
  118. COS(\Gh)^3'
  119.       EQ16B 'Q16B=(
  120. Q11-Q12-2*Q66)*SIN(
  121. \Gh)*COS(\Gh)^3+(Q12-
  122. Q22+2*Q66)*SIN(\Gh)^3
  123. *COS(\Gh)'
  124.       EQ22B 'Q22B=
  125. Q11*SIN(\Gh)^4+2*(Q12
  126. +2*Q66)*SIN(\Gh)^2*
  127. COS(\Gh)^2+Q22*COS(\Gh)
  128. ^4'
  129.       EQ12B 'Q12B=(
  130. Q11+Q22-4*Q66)*SIN(
  131. \Gh)^2*COS(\Gh)^2+Q12*(
  132. SIN(\Gh)^4+COS(\Gh)^4)'
  133.       EQ11B 'Q11B=
  134. Q11*COS(\Gh)^4+2*(Q12
  135. +2*Q66)*SIN(\Gh)^2*
  136. COS(\Gh)^2+Q22*SIN(\Gh)
  137. ^4'
  138.       EQ11 'Q11=E1/
  139. (1-v12*v21)'
  140.       EQ12 'Q12=v12
  141. *E2/(1-v12*v21)'
  142.       EQ22 'Q22=E2/
  143. (1-v12*v21)'
  144.       EQ66 'Q66=G12
  145. '
  146.     END
  147.   ERPT
  148.     \<< EQ\-> EVAL SWAP
  149. STO
  150.     \>>
  151.   CLLAYERS
  152.     \<< CLLCD
  153. "Clear all layers?"
  154. 4 DISP { " " yes
  155. " " " " } TMENU
  156. -1 WAIT
  157.       IF 12.1 SAME
  158.       THEN LAYERS
  159. 'layerlist' RCL
  160. OBJ\-> 1 SWAP
  161.         FOR X EVAL
  162. CLVAR UPDIR
  163.         NEXT
  164. layerlist PURGE { }
  165. 'layerlist' STO 0
  166. 'NoLayers' STO
  167. 'ABDM' EVAL { ABDM
  168. A B D } PURGE UPDIR
  169. UPDIR
  170.       END
  171.     \>>
  172.   CLMAT
  173.     \<< CLLCD
  174. "Clear materials?"
  175. 4 DISP { " " yes }
  176. TMENU -1 WAIT
  177.       IF 12.1 SAME
  178.       THEN
  179. MATERIALS
  180. 'materiallist' RCL
  181. OBJ\-> 1 SWAP
  182.         FOR X EVAL
  183. CLVAR UPDIR
  184.         NEXT
  185. materiallist PURGE
  186. { } 'materiallist'
  187. STO UPDIR
  188.       END
  189.     \>>
  190.   \GDT 0
  191.   ABD2M
  192.     \<< LAYERS ABDM A
  193. { 1 3 } RDM OBJ\->
  194. DROP B { 1 3 } RDM
  195. OBJ\-> DROP 1 3
  196.       FOR X 2 X 2
  197. \->LIST A SWAP GET
  198.       NEXT 1 3
  199.       FOR X 2 X 2
  200. \->LIST B SWAP GET
  201.       NEXT 1 3
  202.       FOR X 3 X 2
  203. \->LIST A SWAP GET
  204.       NEXT 1 3
  205.       FOR X 3 X 2
  206. \->LIST B SWAP GET
  207.       NEXT B { 1 3
  208. } RDM OBJ\-> DROP D {
  209. 1 3 } RDM OBJ\-> DROP
  210. 1 3
  211.       FOR X 2 X 2
  212. \->LIST B SWAP GET
  213.       NEXT 1 3
  214.       FOR X 2 X 2
  215. \->LIST D SWAP GET
  216.       NEXT 1 3
  217.       FOR X 3 X 2
  218. \->LIST B SWAP GET
  219.       NEXT 1 3
  220.       FOR X 3 X 2
  221. \->LIST D SWAP GET
  222.       NEXT { 6 6 }
  223. \->ARRY 'ABDM' STO
  224. UPDIR UPDIR
  225.     \>>
  226.   DMAT
  227.     \<< LAYERS
  228. layerlist OBJ\-> 1
  229. SWAP
  230.       FOR X X ROLL
  231. DUP EVAL "QB" SWAP
  232. + OBJ\-> t zbar SQ *
  233. t t * t * 12 / + *
  234. UPDIR
  235.       NEXT 1
  236. NoLayers 1 -
  237.       FOR X +
  238.       NEXT ABDM D
  239. STO UPDIR UPDIR
  240.     \>>
  241.   BMAT
  242.     \<< LAYERS
  243. layerlist OBJ\-> 1
  244. SWAP
  245.       FOR X X ROLL
  246. DUP EVAL "QB" SWAP
  247. + OBJ\-> t * zbar *
  248. UPDIR
  249.       NEXT 1
  250. NoLayers 1 -
  251.       FOR X +
  252.       NEXT ABDM B
  253. STO UPDIR UPDIR
  254.     \>>
  255.   AMAT
  256.     \<< LAYERS
  257. layerlist OBJ\-> 1
  258. SWAP
  259.       FOR X X ROLL
  260. DUP EVAL "QB" SWAP
  261. + OBJ\-> t * UPDIR
  262.       NEXT 1
  263. NoLayers 1 -
  264.       FOR X +
  265.       NEXT ABDM A
  266. STO UPDIR UPDIR
  267.     \>>
  268.   MATER
  269.     \<<
  270. "
  271.     Material name?"
  272. ":name:" INPUT OBJ\->
  273. OBJ\-> DROP DUP
  274. 'CurrentMat' STO
  275. MATERIALS DUP CRDIR
  276. materiallist +
  277. 'materiallist' STO
  278. UPDIR 1 5
  279.       FOR X INPT
  280.       NEXT
  281.     \>>
  282.   INPT
  283.     \<<
  284. "Variable Name?"
  285. ":name:" { E1 E2
  286. G12 v21 v12 } TMENU
  287. INPUT OBJ\-> OBJ\->
  288. DROP DUP
  289. "Enter Value for: "
  290. SWAP + ":value:"
  291. INPUT OBJ\-> OBJ\->
  292. DROP SWAP CLLCD
  293. MATERIALS
  294. CurrentMat STO
  295. UPDIR UPDIR
  296.     \>>
  297.   LAYER
  298.     \<< "Layer name?"
  299. ":name:" INPUT OBJ\->
  300. OBJ\-> DROP DUP
  301. 'CurrentLayer' STO
  302. LAYERS DUP CRDIR
  303. layerlist +
  304. 'layerlist' STO
  305. layerlist OBJ\->
  306. 'NoLayers' STO
  307. CurrentLayer
  308. "Material?" ":Mat:"
  309. INPUT OBJ\-> OBJ\->
  310. DROP 'Mat' STO
  311. @ [Note: 'MAT' renamed to 'Mat' to prevent TLLIB conflicts.  -jkh-]
  312. "Angle?" ":\Gh:"
  313. INPUT OBJ\-> OBJ\->
  314. OBJ\-> STO "Ztop?"
  315. ":zt:" INPUT OBJ\->
  316. OBJ\-> OBJ\-> STO
  317. "Zbottom?" ":zb:"
  318. INPUT OBJ\-> OBJ\->
  319. OBJ\-> STO zt zb -
  320. 't' STO zt t 2 / -
  321. 'zbar' STO
  322. "\Ga1 for this layer?"
  323. ":\Ga1:" INPUT OBJ\->
  324. OBJ\-> OBJ\-> STO
  325. "\Ga2 for this layer?"
  326. ":\Ga2:" INPUT OBJ\->
  327. OBJ\-> OBJ\-> STO UPDIR
  328. UPDIR CLEAR
  329.     \>>
  330.   CurrentLayer O7
  331.   CurrentMat OP
  332. END
  333.